home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 March / EnigmA AMIGA RUN 05 (1996)(G.R. Edizioni)(IT)[!][issue 1996-03][Skylink CD IV].iso / earcd / gnu / gnpltsrc.lha / internal.c < prev    next >
C/C++ Source or Header  |  1996-01-28  |  19KB  |  996 lines
  1. #ifndef lint
  2. static char *RCSid = "$Id: internal.c,v 1.14 1995/12/02 21:16:39 drd Exp $";
  3. #endif
  4.  
  5.  
  6. /* GNUPLOT - internal.c */
  7. /*
  8.  * Copyright (C) 1986 - 1993   Thomas Williams, Colin Kelley
  9.  *
  10.  * Permission to use, copy, and distribute this software and its
  11.  * documentation for any purpose with or without fee is hereby granted, 
  12.  * provided that the above copyright notice appear in all copies and 
  13.  * that both that copyright notice and this permission notice appear 
  14.  * in supporting documentation.
  15.  *
  16.  * Permission to modify the software is granted, but not the right to
  17.  * distribute the modified code.  Modifications are to be distributed 
  18.  * as patches to released version.
  19.  *  
  20.  * This software is provided "as is" without express or implied warranty.
  21.  * 
  22.  *
  23.  * AUTHORS
  24.  * 
  25.  *   Original Software:
  26.  *     Thomas Williams,  Colin Kelley.
  27.  * 
  28.  *   Gnuplot 2.0 additions:
  29.  *       Russell Lang, Dave Kotz, John Campbell.
  30.  *
  31.  *   Gnuplot 3.0 additions:
  32.  *       Gershon Elber and many others.
  33.  * 
  34.  */
  35.  
  36. #include <math.h>
  37. #include "plot.h"
  38. #include "fnproto.h"
  39.  
  40. /* some machines have trouble with exp(-x) for large x
  41.  * if MINEXP is defined at compile time, use gp_exp(x) instead,
  42.  * which returns 0 for exp(x) with x < MINEXP
  43.  * exp(x) will already have been defined as gp_exp(x) in plot.h
  44.  */
  45.  
  46. #ifdef MINEXP
  47. double gp_exp(x)
  48. double x;
  49. {
  50.     return (x < (MINEXP) ) ? 0.0 : exp(x);
  51. }
  52. #endif
  53.  
  54. TBOOLEAN undefined;
  55.  
  56. struct value *pop(), *Gcomplex(), *Ginteger();
  57. double magnitude(), angle(), real();
  58.  
  59. static void int_check __P((struct value *v));
  60.  
  61. struct value stack[STACK_DEPTH];
  62.  
  63. int s_p = -1;   /* stack pointer */
  64.  
  65.  
  66. /*
  67.  * System V and MSC 4.0 call this when they wants to print an error message.
  68.  * Don't!
  69.  */
  70. #ifndef _CRAY
  71. #if defined(MSDOS) || defined(DOS386)
  72. #ifdef __TURBOC__
  73. int matherr()    /* Turbo C */
  74. #else
  75. int matherr(x)    /* MSC 5.1 */
  76. struct exception *x;
  77. #endif /* TURBOC */
  78. #else /* not MSDOS */
  79. #ifdef apollo
  80. int matherr(struct exception *x)    /* apollo */
  81. #else /* apollo */
  82. #if defined(AMIGA_SC_6_1)
  83. int __matherr(struct __exception *x)
  84. #else
  85. #if defined(ATARI)&&defined(__GNUC__)||defined(MTOS)&&defined(__GNUC__)||defined(__hpux)||defined(PLOSS) ||defined(SOLARIS)
  86. int matherr(x)
  87. struct exception *x;
  88. #else    /* Most everyone else (not apollo). */
  89. int matherr()
  90. #endif /* GCC_ST || HPUX || SOLARIS */
  91. #endif /* AMIGA_SC_6_1 */
  92. #endif /* apollo */
  93. #endif /* MSDOS */
  94. {
  95.     return (undefined = TRUE);        /* don't print error message */
  96. }
  97. #endif /* not _CRAY */
  98.  
  99.  
  100. void reset_stack()
  101. {
  102.     s_p = -1;
  103. }
  104.  
  105.  
  106. void check_stack()    /* make sure stack's empty */
  107. {
  108.     if (s_p != -1)
  109.         fprintf(stderr,"\nwarning:  internal error--stack not empty!\n");
  110. }
  111.  
  112. #define BAD_DEFAULT default: int_error("interal error : type neither INT or CMPLX", NO_CARET); return;
  113.  
  114. struct value *pop(x)
  115. struct value *x;
  116. {
  117.     if (s_p  < 0 )
  118.         int_error("stack underflow",NO_CARET);
  119.     *x = stack[s_p--];
  120.     return(x);
  121. }
  122.  
  123.  
  124. void push(x)
  125. struct value *x;
  126. {
  127.     if (s_p == STACK_DEPTH - 1)
  128.         int_error("stack overflow",NO_CARET);
  129.     stack[++s_p] = *x;
  130. }
  131.  
  132.  
  133. #define ERR_VAR "undefined variable: "
  134.  
  135. void f_push(x)
  136. union argument *x;        /* contains pointer to value to push; */
  137. {
  138. static char err_str[sizeof(ERR_VAR) + MAX_ID_LEN] = ERR_VAR;
  139. struct udvt_entry *udv;
  140.  
  141.     udv = x->udv_arg;
  142.     if (udv->udv_undef) {     /* undefined */
  143.         (void) strcpy(&err_str[sizeof(ERR_VAR) - 1], udv->udv_name);
  144.         int_error(err_str,NO_CARET);
  145.     }
  146.     push(&(udv->udv_value));
  147. }
  148.  
  149.  
  150. void f_pushc(x)
  151. union argument *x;
  152. {
  153.     push(&(x->v_arg));
  154. }
  155.  
  156.  
  157. void f_pushd1(x)
  158. union argument *x;
  159. {
  160.     push(&(x->udf_arg->dummy_values[0]));
  161. }
  162.  
  163.  
  164. void f_pushd2(x)
  165. union argument *x;
  166. {
  167.     push(&(x->udf_arg->dummy_values[1]));
  168. }
  169.  
  170.  
  171. void f_pushd(x)
  172. union argument *x;
  173. {
  174. struct value param;
  175.     (void) pop(¶m);
  176.     push(&(x->udf_arg->dummy_values[param.v.int_val]));
  177. }
  178.  
  179.  
  180. #define ERR_FUN "undefined function: "
  181.  
  182. void f_call(x)  /* execute a udf */
  183. union argument *x;
  184. {
  185. static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
  186. register struct udft_entry *udf;
  187. struct value save_dummy;
  188.  
  189.     udf = x->udf_arg;
  190.     if (!udf->at) { /* undefined */
  191.         (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
  192.                 udf->udf_name);
  193.         int_error(err_str,NO_CARET);
  194.     }
  195.     save_dummy = udf->dummy_values[0];
  196.     (void) pop(&(udf->dummy_values[0]));
  197.  
  198.     execute_at(udf->at);
  199.     udf->dummy_values[0] = save_dummy;
  200. }
  201.  
  202.  
  203. void f_calln(x)  /* execute a udf of n variables */
  204. union argument *x;
  205. {
  206. static char err_str[sizeof(ERR_FUN) + MAX_ID_LEN] = ERR_FUN;
  207. register struct udft_entry *udf;
  208. struct value save_dummy[MAX_NUM_VAR];
  209.  
  210.     int i;
  211.     int num_pop;
  212.     struct value num_params;
  213.  
  214.     udf = x->udf_arg;
  215.     if (!udf->at) { /* undefined */
  216.         (void) strcpy(&err_str[sizeof(ERR_FUN) - 1],
  217.                 udf->udf_name);
  218.         int_error(err_str,NO_CARET);
  219.     }
  220.     for(i=0; i<MAX_NUM_VAR; i++) 
  221.         save_dummy[i] = udf->dummy_values[i];
  222.  
  223.     /* if there are more parameters than the function is expecting */
  224.     /* simply ignore the excess */
  225.     (void) pop(&num_params);
  226.  
  227.     if(num_params.v.int_val > MAX_NUM_VAR) {
  228.         /* pop the dummies that there is no room for */
  229.         num_pop = num_params.v.int_val - MAX_NUM_VAR;
  230.         for(i=0; i< num_pop; i++)
  231.             (void) pop(&(udf->dummy_values[i]));
  232.  
  233.         num_pop = MAX_NUM_VAR;
  234.     } else {
  235.         num_pop = num_params.v.int_val;
  236.     }
  237.  
  238.     /* pop parameters we can use */
  239.     for(i=num_pop-1; i>=0; i--)
  240.         (void) pop(&(udf->dummy_values[i]));
  241.  
  242.     execute_at(udf->at);
  243.     for(i=0; i<MAX_NUM_VAR; i++) 
  244.         udf->dummy_values[i] = save_dummy[i];
  245. }
  246.  
  247.  
  248. static void int_check(v)
  249. struct value *v;
  250. {
  251.     if (v->type != INTGR)
  252.         int_error("non-integer passed to boolean operator",NO_CARET);
  253. }
  254.  
  255.  
  256. void f_lnot()
  257. {
  258. struct value a;
  259.     int_check(pop(&a));
  260.     push(Ginteger(&a,!a.v.int_val) );
  261. }
  262.  
  263.  
  264. void f_bnot()
  265. {
  266. struct value a;
  267.     int_check(pop(&a));
  268.     push( Ginteger(&a,~a.v.int_val) );
  269. }
  270.  
  271.  
  272. void f_bool()
  273. {            /* converts top-of-stack to boolean */
  274.     int_check(&top_of_stack);
  275.     top_of_stack.v.int_val = !!top_of_stack.v.int_val;
  276. }
  277.  
  278.  
  279. void f_lor()
  280. {
  281. struct value a,b;
  282.     int_check(pop(&b));
  283.     int_check(pop(&a));
  284.     push( Ginteger(&a,a.v.int_val || b.v.int_val) );
  285. }
  286.  
  287. void f_land()
  288. {
  289. struct value a,b;
  290.     int_check(pop(&b));
  291.     int_check(pop(&a));
  292.     push( Ginteger(&a,a.v.int_val && b.v.int_val) );
  293. }
  294.  
  295.  
  296. void f_bor()
  297. {
  298. struct value a,b;
  299.     int_check(pop(&b));
  300.     int_check(pop(&a));
  301.     push( Ginteger(&a,a.v.int_val | b.v.int_val) );
  302. }
  303.  
  304.  
  305. void f_xor()
  306. {
  307. struct value a,b;
  308.     int_check(pop(&b));
  309.     int_check(pop(&a));
  310.     push( Ginteger(&a,a.v.int_val ^ b.v.int_val) );
  311. }
  312.  
  313.  
  314. void f_band()
  315. {
  316. struct value a,b;
  317.     int_check(pop(&b));
  318.     int_check(pop(&a));
  319.     push( Ginteger(&a,a.v.int_val & b.v.int_val) );
  320. }
  321.  
  322.  
  323. void f_uminus()
  324. {
  325. struct value a;
  326.     (void) pop(&a);
  327.     switch(a.type) {
  328.         case INTGR:
  329.             a.v.int_val = -a.v.int_val;
  330.             break;
  331.         case CMPLX:
  332.             a.v.cmplx_val.real =
  333.                 -a.v.cmplx_val.real;
  334.             a.v.cmplx_val.imag =
  335.                 -a.v.cmplx_val.imag;
  336.             break;
  337.         BAD_DEFAULT
  338.     }
  339.     push(&a);
  340. }
  341.  
  342.  
  343. void f_eq() /* note: floating point equality is rare because of roundoff error! */
  344. {
  345. struct value a, b;
  346.     register int result;
  347.     (void) pop(&b);
  348.     (void) pop(&a);
  349.     switch(a.type) {
  350.         case INTGR:
  351.             switch (b.type) {
  352.                 case INTGR:
  353.                     result = (a.v.int_val ==
  354.                         b.v.int_val);
  355.                     break;
  356.                 case CMPLX:
  357.                     result = (a.v.int_val ==
  358.                         b.v.cmplx_val.real &&
  359.                        b.v.cmplx_val.imag == 0.0);
  360.                     break;
  361.                 BAD_DEFAULT
  362.             }
  363.             break;
  364.         case CMPLX:
  365.             switch (b.type) {
  366.                 case INTGR:
  367.                     result = (b.v.int_val == a.v.cmplx_val.real &&
  368.                        a.v.cmplx_val.imag == 0.0);
  369.                     break;
  370.                 case CMPLX:
  371.                     result = (a.v.cmplx_val.real==
  372.                         b.v.cmplx_val.real &&
  373.                         a.v.cmplx_val.imag==
  374.                         b.v.cmplx_val.imag);
  375.                     break;
  376.                 BAD_DEFAULT
  377.             }
  378.             break;
  379.         BAD_DEFAULT
  380.     }
  381.     push(Ginteger(&a,result));
  382. }
  383.  
  384.  
  385. void f_ne()
  386. {
  387. struct value a, b;
  388.     register int result;
  389.     (void) pop(&b);
  390.     (void) pop(&a);
  391.     switch(a.type) {
  392.         case INTGR:
  393.             switch (b.type) {
  394.                 case INTGR:
  395.                     result = (a.v.int_val !=
  396.                         b.v.int_val);
  397.                     break;
  398.                 case CMPLX:
  399.                     result = (a.v.int_val !=
  400.                         b.v.cmplx_val.real ||
  401.                        b.v.cmplx_val.imag != 0.0);
  402.                     break;
  403.                 BAD_DEFAULT
  404.             }
  405.             break;
  406.         case CMPLX:
  407.             switch (b.type) {
  408.                 case INTGR:
  409.                     result = (b.v.int_val !=
  410.                         a.v.cmplx_val.real ||
  411.                        a.v.cmplx_val.imag != 0.0);
  412.                     break;
  413.                 case CMPLX:
  414.                     result = (a.v.cmplx_val.real !=
  415.                         b.v.cmplx_val.real ||
  416.                         a.v.cmplx_val.imag !=
  417.                         b.v.cmplx_val.imag);
  418.                     break;
  419.                 BAD_DEFAULT
  420.             }
  421.             break;
  422.         BAD_DEFAULT
  423.     }
  424.     push(Ginteger(&a,result));
  425. }
  426.  
  427.  
  428. void f_gt()
  429. {
  430. struct value a, b;
  431.     register int result;
  432.     (void) pop(&b);
  433.     (void) pop(&a);
  434.     switch(a.type) {
  435.         case INTGR:
  436.             switch (b.type) {
  437.                 case INTGR:
  438.                     result = (a.v.int_val >
  439.                         b.v.int_val);
  440.                     break;
  441.                 case CMPLX:
  442.                     result = (a.v.int_val >
  443.                         b.v.cmplx_val.real);
  444.                     break;
  445.                 BAD_DEFAULT
  446.             }
  447.             break;
  448.         case CMPLX:
  449.             switch (b.type) {
  450.                 case INTGR:
  451.                     result = (a.v.cmplx_val.real >
  452.                         b.v.int_val);
  453.                     break;
  454.                 case CMPLX:
  455.                     result = (a.v.cmplx_val.real >
  456.                         b.v.cmplx_val.real);
  457.                     break;
  458.                 BAD_DEFAULT
  459.             }
  460.             break;
  461.         BAD_DEFAULT
  462.     }
  463.     push(Ginteger(&a,result));
  464. }
  465.  
  466.  
  467. void f_lt()
  468. {
  469. struct value a, b;
  470.     register int result;
  471.     (void) pop(&b);
  472.     (void) pop(&a);
  473.     switch(a.type) {
  474.         case INTGR:
  475.             switch (b.type) {
  476.                 case INTGR:
  477.                     result = (a.v.int_val <
  478.                         b.v.int_val);
  479.                     break;
  480.                 case CMPLX:
  481.                     result = (a.v.int_val <
  482.                         b.v.cmplx_val.real);
  483.                     break;
  484.                 BAD_DEFAULT
  485.             }
  486.             break;
  487.         case CMPLX:
  488.             switch (b.type) {
  489.                 case INTGR:
  490.                     result = (a.v.cmplx_val.real <
  491.                         b.v.int_val);
  492.                     break;
  493.                 case CMPLX:
  494.                     result = (a.v.cmplx_val.real <
  495.                         b.v.cmplx_val.real);
  496.                     break;
  497.                 BAD_DEFAULT
  498.             }
  499.             break;
  500.         BAD_DEFAULT
  501.     }
  502.     push(Ginteger(&a,result));
  503. }
  504.  
  505.  
  506. void f_ge()
  507. {
  508. struct value a, b;
  509.     register int result;
  510.     (void) pop(&b);
  511.     (void) pop(&a);
  512.     switch(a.type) {
  513.         case INTGR:
  514.             switch (b.type) {
  515.                 case INTGR:
  516.                     result = (a.v.int_val >=
  517.                         b.v.int_val);
  518.                     break;
  519.                 case CMPLX:
  520.                     result = (a.v.int_val >=
  521.                         b.v.cmplx_val.real);
  522.                     break;
  523.                 BAD_DEFAULT
  524.             }
  525.             break;
  526.         case CMPLX:
  527.             switch (b.type) {
  528.                 case INTGR:
  529.                     result = (a.v.cmplx_val.real >=
  530.                         b.v.int_val);
  531.                     break;
  532.                 case CMPLX:
  533.                     result = (a.v.cmplx_val.real >=
  534.                         b.v.cmplx_val.real);
  535.                     break;
  536.                 BAD_DEFAULT
  537.             }
  538.             break;
  539.         BAD_DEFAULT
  540.     }
  541.     push(Ginteger(&a,result));
  542. }
  543.  
  544.  
  545. void f_le()
  546. {
  547. struct value a, b;
  548.     register int result;
  549.     (void) pop(&b);
  550.     (void) pop(&a);
  551.     switch(a.type) {
  552.         case INTGR:
  553.             switch (b.type) {
  554.                 case INTGR:
  555.                     result = (a.v.int_val <=
  556.                         b.v.int_val);
  557.                     break;
  558.                 case CMPLX:
  559.                     result = (a.v.int_val <=
  560.                         b.v.cmplx_val.real);
  561.                     break;
  562.                 BAD_DEFAULT
  563.             }
  564.             break;
  565.         case CMPLX:
  566.             switch (b.type) {
  567.                 case INTGR:
  568.                     result = (a.v.cmplx_val.real <=
  569.                         b.v.int_val);
  570.                     break;
  571.                 case CMPLX:
  572.                     result = (a.v.cmplx_val.real <=
  573.                         b.v.cmplx_val.real);
  574.                     break;
  575.                 BAD_DEFAULT
  576.             }
  577.             break;
  578.         BAD_DEFAULT
  579.     }
  580.     push(Ginteger(&a,result));
  581. }
  582.  
  583.  
  584. void f_plus()
  585. {
  586. struct value a, b, result;
  587.     (void) pop(&b);
  588.     (void) pop(&a);
  589.     switch(a.type) {
  590.         case INTGR:
  591.             switch (b.type) {
  592.                 case INTGR:
  593.                     (void) Ginteger(&result,a.v.int_val +
  594.                         b.v.int_val);
  595.                     break;
  596.                 case CMPLX:
  597.                     (void) Gcomplex(&result,a.v.int_val +
  598.                         b.v.cmplx_val.real,
  599.                        b.v.cmplx_val.imag);
  600.                     break;
  601.                 BAD_DEFAULT
  602.             }
  603.             break;
  604.         case CMPLX:
  605.             switch (b.type) {
  606.                 case INTGR:
  607.                     (void) Gcomplex(&result,b.v.int_val +
  608.                         a.v.cmplx_val.real,
  609.                        a.v.cmplx_val.imag);
  610.                     break;
  611.                 case CMPLX:
  612.                     (void) Gcomplex(&result,a.v.cmplx_val.real+
  613.                         b.v.cmplx_val.real,
  614.                         a.v.cmplx_val.imag+
  615.                         b.v.cmplx_val.imag);
  616.                     break;
  617.                 BAD_DEFAULT
  618.             }
  619.             break;
  620.         BAD_DEFAULT
  621.     }
  622.     push(&result);
  623. }
  624.  
  625.  
  626. void f_minus()
  627. {
  628. struct value a, b, result;
  629.     (void) pop(&b);
  630.     (void) pop(&a);        /* now do a - b */
  631.     switch(a.type) {
  632.         case INTGR:
  633.             switch (b.type) {
  634.                 case INTGR:
  635.                     (void) Ginteger(&result,a.v.int_val -
  636.                         b.v.int_val);
  637.                     break;
  638.                 case CMPLX:
  639.                     (void) Gcomplex(&result,a.v.int_val -
  640.                         b.v.cmplx_val.real,
  641.                        -b.v.cmplx_val.imag);
  642.                     break;
  643.                 BAD_DEFAULT
  644.             }
  645.             break;
  646.         case CMPLX:
  647.             switch (b.type) {
  648.                 case INTGR:
  649.                     (void) Gcomplex(&result,a.v.cmplx_val.real -
  650.                         b.v.int_val,
  651.                         a.v.cmplx_val.imag);
  652.                     break;
  653.                 case CMPLX:
  654.                     (void) Gcomplex(&result,a.v.cmplx_val.real-
  655.                         b.v.cmplx_val.real,
  656.                         a.v.cmplx_val.imag-
  657.                         b.v.cmplx_val.imag);
  658.                     break;
  659.                 BAD_DEFAULT
  660.             }
  661.             break;
  662.         BAD_DEFAULT
  663.     }
  664.     push(&result);
  665. }
  666.  
  667.  
  668. void f_mult()
  669. {
  670. struct value a, b, result;
  671.     (void) pop(&b);
  672.     (void) pop(&a);    /* now do a*b */
  673.  
  674.     switch(a.type) {
  675.         case INTGR:
  676.             switch (b.type) {
  677.                 case INTGR:
  678.                     (void) Ginteger(&result,a.v.int_val *
  679.                         b.v.int_val);
  680.                     break;
  681.                 case CMPLX:
  682.                     (void) Gcomplex(&result,a.v.int_val *
  683.                         b.v.cmplx_val.real,
  684.                         a.v.int_val *
  685.                         b.v.cmplx_val.imag);
  686.                     break;
  687.                 BAD_DEFAULT
  688.             }
  689.             break;
  690.         case CMPLX:
  691.             switch (b.type) {
  692.                 case INTGR:
  693.                     (void) Gcomplex(&result,b.v.int_val *
  694.                         a.v.cmplx_val.real,
  695.                         b.v.int_val *
  696.                         a.v.cmplx_val.imag);
  697.                     break;
  698.                 case CMPLX:
  699.                     (void) Gcomplex(&result,a.v.cmplx_val.real*
  700.                         b.v.cmplx_val.real-
  701.                         a.v.cmplx_val.imag*
  702.                         b.v.cmplx_val.imag,
  703.                         a.v.cmplx_val.real*
  704.                         b.v.cmplx_val.imag+
  705.                         a.v.cmplx_val.imag*
  706.                         b.v.cmplx_val.real);
  707.                     break;
  708.                 BAD_DEFAULT
  709.             }
  710.             break;
  711.         BAD_DEFAULT
  712.     }
  713.     push(&result);
  714. }
  715.  
  716.  
  717. void f_div()
  718. {
  719. struct value a, b, result;
  720. register double square;
  721.     (void) pop(&b);
  722.     (void) pop(&a);    /* now do a/b */
  723.  
  724.     switch(a.type) {
  725.         case INTGR:
  726.             switch (b.type) {
  727.                 case INTGR:
  728.                     if (b.v.int_val)
  729.                       (void) Ginteger(&result,a.v.int_val /
  730.                         b.v.int_val);
  731.                     else {
  732.                       (void) Ginteger(&result,0);
  733.                       undefined = TRUE;
  734.                     }
  735.                     break;
  736.                 case CMPLX:
  737.                     square = b.v.cmplx_val.real*
  738.                         b.v.cmplx_val.real +
  739.                         b.v.cmplx_val.imag*
  740.                         b.v.cmplx_val.imag;
  741.                     if (square)
  742.                         (void) Gcomplex(&result,a.v.int_val*
  743.                         b.v.cmplx_val.real/square,
  744.                         -a.v.int_val*
  745.                         b.v.cmplx_val.imag/square);
  746.                     else {
  747.                         (void) Gcomplex(&result,0.0,0.0);
  748.                         undefined = TRUE;
  749.                     }
  750.                     break;
  751.                 BAD_DEFAULT
  752.             }
  753.             break;
  754.         case CMPLX:
  755.             switch (b.type) {
  756.                 case INTGR:
  757.                     if (b.v.int_val)
  758.                       
  759.                       (void) Gcomplex(&result,a.v.cmplx_val.real/
  760.                         b.v.int_val,
  761.                         a.v.cmplx_val.imag/
  762.                         b.v.int_val);
  763.                     else {
  764.                         (void) Gcomplex(&result,0.0,0.0);
  765.                         undefined = TRUE;
  766.                     }
  767.                     break;
  768.                 case CMPLX:
  769.                     square = b.v.cmplx_val.real*
  770.                         b.v.cmplx_val.real +
  771.                         b.v.cmplx_val.imag*
  772.                         b.v.cmplx_val.imag;
  773.                     if (square)
  774.                     (void) Gcomplex(&result,(a.v.cmplx_val.real*
  775.                         b.v.cmplx_val.real+
  776.                         a.v.cmplx_val.imag*
  777.                         b.v.cmplx_val.imag)/square,
  778.                         (a.v.cmplx_val.imag*
  779.                         b.v.cmplx_val.real-
  780.                         a.v.cmplx_val.real*
  781.                         b.v.cmplx_val.imag)/
  782.                             square);
  783.                     else {
  784.                         (void) Gcomplex(&result,0.0,0.0);
  785.                         undefined = TRUE;
  786.                     }
  787.                     break;
  788.                 BAD_DEFAULT
  789.             }
  790.             break;
  791.         BAD_DEFAULT
  792.     }
  793.     push(&result);
  794. }
  795.  
  796.  
  797. void f_mod()
  798. {
  799. struct value a, b;
  800.     (void) pop(&b);
  801.     (void) pop(&a);    /* now do a%b */
  802.  
  803.     if (a.type != INTGR || b.type != INTGR)
  804.         int_error("can only mod ints",NO_CARET);
  805.     if (b.v.int_val)
  806.         push(Ginteger(&a,a.v.int_val % b.v.int_val));
  807.     else {
  808.         push(Ginteger(&a,0));
  809.         undefined = TRUE;
  810.     }
  811. }
  812.  
  813.  
  814. void f_power()
  815. {
  816. struct value a, b, result;
  817. register int i, t, count;
  818. register double mag, ang;
  819.     (void) pop(&b);
  820.     (void) pop(&a);    /* now find a**b */
  821.  
  822.     switch(a.type) {
  823.         case INTGR:
  824.             switch (b.type) {
  825.                 case INTGR:
  826.                     count = abs(b.v.int_val);
  827.                     t = 1;
  828.             /* this ought to use bit-masks and squares, etc */
  829.                     for(i = 0; i < count; i++)
  830.                         t *= a.v.int_val;
  831.                     if (b.v.int_val >= 0)
  832.                         (void) Ginteger(&result,t);
  833.                     else
  834.                       if (t != 0)
  835.                         (void) Gcomplex(&result,1.0/t,0.0);
  836.                       else {
  837.                          undefined = TRUE;
  838.                          (void) Gcomplex(&result, 0.0, 0.0);
  839.                       }
  840.                     break;
  841.                 case CMPLX:
  842.                     if (a.v.int_val==0) {
  843.                       if(b.v.cmplx_val.imag!=0 || b.v.cmplx_val.real<0) {
  844.                         undefined = TRUE;
  845.                       }
  846.                       /* return 1.0 for 0**0 */
  847.                       Gcomplex(&result, b.v.cmplx_val.real==0 ? 1.0 : 0.0, 0.0);
  848.                     } else {
  849.                       mag =
  850.                         pow(magnitude(&a),fabs(b.v.cmplx_val.real));
  851.                       if (b.v.cmplx_val.real < 0.0)
  852.                         if (mag != 0.0)
  853.                           mag = 1.0/mag;
  854.                        else 
  855.                           undefined = TRUE;
  856.                       mag *= gp_exp(-b.v.cmplx_val.imag*angle(&a));
  857.                       ang = b.v.cmplx_val.real*angle(&a) +
  858.                             b.v.cmplx_val.imag*log(magnitude(&a));
  859.                       (void) Gcomplex(&result,mag*cos(ang),
  860.                           mag*sin(ang));
  861.                     }
  862.                     break;
  863.                 BAD_DEFAULT
  864.             }
  865.             break;
  866.         case CMPLX:
  867.             switch (b.type) {
  868.                 case INTGR:
  869.                     if (a.v.cmplx_val.imag == 0.0) {
  870.                         mag = pow(a.v.cmplx_val.real,(double)abs(b.v.int_val));
  871.                         if (b.v.int_val < 0)
  872.                           if (mag != 0.0)
  873.                             mag = 1.0/mag;
  874.                           else 
  875.                             undefined = TRUE;
  876.                         (void) Gcomplex(&result,mag,0.0);
  877.                     }
  878.                     else {
  879.                         /* not so good, but...! */
  880.                         mag = pow(magnitude(&a),(double)abs(b.v.int_val));
  881.                         if (b.v.int_val < 0)
  882.                           if (mag != 0.0)
  883.                             mag = 1.0/mag;
  884.                           else 
  885.                             undefined = TRUE;
  886.                         ang = angle(&a)*b.v.int_val;
  887.                         (void) Gcomplex(&result,mag*cos(ang),
  888.                             mag*sin(ang));
  889.                     }
  890.                     break;
  891.                 case CMPLX:
  892.                     if (a.v.cmplx_val.real==0 && a.v.cmplx_val.imag==0) {
  893.                       if(b.v.cmplx_val.imag!=0 || b.v.cmplx_val.real<0) {
  894.                         undefined = TRUE;
  895.                       }
  896.                       /* return 1.0 for 0**0 */
  897.                       Gcomplex(&result, b.v.cmplx_val.real==0 ? 1.0 : 0.0, 0.0);
  898.                     } else {
  899.                       mag = pow(magnitude(&a),fabs(b.v.cmplx_val.real));
  900.                       if (b.v.cmplx_val.real < 0.0)
  901.                         if (mag != 0.0)
  902.                           mag = 1.0/mag;
  903.                         else 
  904.                           undefined = TRUE;
  905.                       mag *= gp_exp(-b.v.cmplx_val.imag*angle(&a));
  906.                       ang = b.v.cmplx_val.real*angle(&a) +
  907.                             b.v.cmplx_val.imag*log(magnitude(&a));
  908.                       (void) Gcomplex(&result,mag*cos(ang),
  909.                           mag*sin(ang));
  910.                     }
  911.                     break;
  912.                 BAD_DEFAULT
  913.             }
  914.             break;
  915.         BAD_DEFAULT
  916.     }
  917.     push(&result);
  918. }
  919.  
  920.  
  921. void f_factorial()
  922. {
  923. struct value a;
  924. register int i;
  925. register double val;
  926.  
  927.     (void) pop(&a);    /* find a! (factorial) */
  928.  
  929.     switch (a.type) {
  930.         case INTGR:
  931.             val = 1.0;
  932.             for (i = a.v.int_val; i > 1; i--)  /*fpe's should catch overflows*/
  933.                 val *= i;
  934.             break;
  935.         default:
  936.             int_error("factorial (!) argument must be an integer",
  937.             NO_CARET);
  938.             return; /* avoid gcc -Wall warning about val */
  939.         }
  940.  
  941.     push(Gcomplex(&a,val,0.0));
  942.             
  943. }
  944.  
  945.  
  946. int
  947. f_jump(x)
  948. union argument *x;
  949. {
  950.     return(x->j_arg);
  951. }
  952.  
  953.  
  954. int
  955. f_jumpz(x)
  956. union argument *x;
  957. {
  958. struct value a;
  959.     int_check(&top_of_stack);
  960.     if (top_of_stack.v.int_val) {    /* non-zero */
  961.         (void) pop(&a);
  962.         return 1;                /* no jump */
  963.     }
  964.     else
  965.         return(x->j_arg);        /* leave the argument on TOS */
  966. }
  967.  
  968.  
  969. int
  970. f_jumpnz(x)
  971. union argument *x;
  972. {
  973. struct value a;
  974.     int_check(&top_of_stack);
  975.     if (top_of_stack.v.int_val)    /* non-zero */
  976.         return(x->j_arg);        /* leave the argument on TOS */
  977.     else {
  978.         (void) pop(&a);
  979.         return 1;                /* no jump */
  980.     }
  981. }
  982.  
  983.  
  984. int
  985. f_jtern(x)
  986. union argument *x;
  987. {
  988. struct value a;
  989.  
  990.     int_check(pop(&a));
  991.     if (a.v.int_val)
  992.         return(1);                /* no jump; fall through to TRUE code */
  993.     else
  994.         return(x->j_arg);        /* go jump to FALSE code */
  995. }
  996.